home *** CD-ROM | disk | FTP | other *** search
- '------------------------------------------------------------------------------
- ' TITLE: event shell
- ' DATE: March 6, 1991
- ' AUTHOR: R. Gonzalez
- '
- ' DESCRIPTION: Sample event-loop application, for use as a shell to develop
- ' new applications. Demonstrates defining menus and windows and polling for
- ' events. Also demonstrates how to verify edit field values (try typing "Richard
- ' Nixon" in the data field), show alternative cursors (select the "Preferences"
- ' menu item), and track the mouse position.
- '
- ' To make your own event-loop application, do the following:
- ' (1) Change the menu routines to suit your application. You may leave the
- ' File menu (and handle.file.menu) unchanged if desired.
- ' (2) Define global (DIM SHARED) variables for your data, in place of those
- ' I've defined (mine begin with "dd").
- ' (3) Change initialize.data, save.data, load.data, and the window, button,
- ' and edit field routines to handle your own data accordingly.
- ' (4) Set the global variable changes% to TRUE% and call menu.after.changes
- ' when the user changes one of your own global data variables. Note that
- ' if you have edit fields then you may need to actively check whether
- ' the user has typed anything - see my use of check.for.edit.changes.
- '
- ' COMPILING: Remove STATIC declarations, uncomment indicated lines
- ' Check: Include MBPCs & MBLCs, Include runtime code, Make all arrays static,
- ' Use default window & menu, (if available: Generate 68020 & 68881 code).
- '
- ' (MODIFICATION HISTORY)
- ' DATE:
- ' AUTHOR:
- ' DESCRIPTION:
- '------------------------------------------------------------------------------
-
- ' these variables may be shared among several subprograms:
- DIM SHARED TRUE%,FALSE%,menu.state%,changes%,window.open%,winx%,winy%
- DIM SHARED pi,pic%(2400),selected.field%
- ' global data variables:
- DIM SHARED dd.edit1$,dd.edit2$,dd.circle.on%
- '------------------------------------------------------------------------------
- ' main procedure
- '------------------------------------------------------------------------------
- 'MAIN
-
- DIM done%,menu.event%,window.event%,window.number%,mouse.event%
- DIM file.name$
-
- WINDOW CLOSE 1 'close default window
-
- TRUE% = -1
- FALSE% = 0
- pi = 3.14159
-
- initialize.data
- setup.menu
- file.name$ = "Untitled"
- open.main.window file.name$,TRUE%
- window.open% = TRUE%
- done% = FALSE%
-
- ' main event loop
- WHILE NOT done%
-
- menu.event% = MENU(0)
- IF menu.event% <> 0 THEN
- handle.menu menu.event%,file.name$,done%
- END IF
-
- window.event% = DIALOG(0)
- 'In case you decide to use multiple windows:
- window.number% = WINDOW(0)
- IF window.event% <> 0 THEN
- handle.window window.event%,window.number%,file.name$
- END IF
-
- mouse.event% = MOUSE(0)
- IF window.open% AND mouse.event% <> 0 THEN
- handle.mouse mouse.event%,window.number%
- END IF
-
- 'No QuickBASIC event is generated when you type in an edit field,
- 'so check for changes periodically:
- IF window.open% THEN
- check.for.edit.changes
- END IF
-
- WEND
-
- END
-
- '------------------------------------------------------------------------------
- ' initialize global data
- '------------------------------------------------------------------------------
- SUB initialize.data STATIC
-
- dd.edit1$ = ""
- dd.edit2$ = ""
- dd.circle.on% = FALSE%
-
- changes% = FALSE%
- selected.field% = 1
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' set up opening menu
- '------------------------------------------------------------------------------
- SUB setup.menu STATIC
-
- menu.state% = 0
-
- MENU 1,0,1,"File"
- MENU 1,1,1,"New"
- MENU 1,2,1,"Open...":cmdkey 1,2,"O"
- MENU 1,3,1,"Close"
- MENU 1,4,0,"Save":cmdkey 1,4,"S"
- MENU 1,5,1,"Save As..."
- MENU 1,6,1,"Print..."
- MENU 1,7,1,"Quit":cmdkey 1,7,"Q"
-
- ' use default edit menu
-
- MENU 3,0,1,"Data"
- MENU 3,1,1,"Preferences..."
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' menu when no window open
- '------------------------------------------------------------------------------
- SUB windowless.menu STATIC
-
- menu.state% = 1
-
- MENU 1,0,1,"File"
- MENU 1,1,1,"New"
- MENU 1,2,1,"Open...":cmdkey 1,2,"O"
- MENU 1,3,0,"Close"
- MENU 1,4,0,"Save":cmdkey 1,4,"S"
- MENU 1,5,0,"Save As..."
- MENU 1,6,0,"Print..."
- MENU 1,7,1,"Quit":cmdkey 1,7,"Q"
-
- ' use default edit menu
-
- MENU 3,0,0,"Data"
- MENU 3,1,0,"Preferences..."
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' menu when window contents have changed
- '------------------------------------------------------------------------------
- SUB menu.after.changes STATIC
-
- menu.state% = 2
-
- MENU 1,0,1,"File"
- MENU 1,1,1,"New"
- MENU 1,2,1,"Open...":cmdkey 1,2,"O"
- MENU 1,3,1,"Close"
- MENU 1,4,1,"Save":cmdkey 1,4,"S"
- MENU 1,5,1,"Save As..."
- MENU 1,6,1,"Print..."
- MENU 1,7,1,"Quit":cmdkey 1,7,"Q"
-
- ' use default edit menu
-
- MENU 3,0,1,"Data"
- MENU 3,1,1,"Preferences..."
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' redraw current menu
- '------------------------------------------------------------------------------
- SUB restore.menu STATIC
-
- SELECT CASE menu.state%
- CASE 0: setup.menu
-
- CASE 1: windowless.menu
-
- CASE 2: menu.after.changes
-
- CASE ELSE:
-
- END SELECT
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' check what menu was chosen
- '------------------------------------------------------------------------------
- SUB handle.menu (menu.no%,file.name$,done%) STATIC
-
- ' for compiler only:
- ' dim menu.item%
-
- menu.item% = MENU(1)
-
- SELECT CASE menu.no%
- CASE 1: handle.file.menu menu.item%,file.name$,done%
-
- ' let QB handle the default edit menu on its own
-
- CASE 3: handle.data.menu menu.item%
-
- CASE ELSE:
-
- END SELECT
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' check what file menu item was chosen
- '------------------------------------------------------------------------------
- SUB handle.file.menu (menu.item%,file.name$,done%) STATIC
-
- ' for compiler only:
- ' dim new.name$,short.name$,success%
-
- SELECT CASE menu.item%
- CASE 1: IF window.open% THEN
- close.main.window success%
- window.open% = NOT success%
- END IF
- IF NOT window.open% THEN
- file.name$ = "Untitled"
- initialize.data
- open.main.window file.name$,TRUE%
- window.open% = TRUE%
- setup.menu
- ELSE
- restore.menu
- END IF
-
- CASE 2: IF window.open% THEN
- close.main.window success%
- window.open% = NOT success%
- END IF
- IF NOT window.open% THEN
- new.name$ = FILES$(1,"TEXT")
- IF new.name$ <> "" THEN
- file.name$ = new.name$
- open.main.window file.name$,TRUE%
- window.open% = TRUE%
- setup.menu
- ELSE
- windowless.menu
- END IF
- ELSE
- restore.menu
- END IF
-
- CASE 3: close.main.window success%
- window.open% = NOT success%
- IF NOT window.open% THEN
- file.name$ = ""
- windowless.menu
- ELSE
- restore.menu
- END IF
-
- CASE 4: IF file.name$ = "Untitled" THEN
- new.name$ = FILES$(0,"Save file as:")
- IF new.name$ <> "" THEN
- file.name$ = new.name$
- strip.folders file.name$,short.name$
- WINDOW 1,short.name$
- END IF
- refresh.main.window file.name$
- END IF
- IF file.name$ <> "Untitled" THEN
- save.data file.name$
- setup.menu
- ELSE
- restore.menu
- END IF
-
- CASE 5: new.name$ = FILES$(0,"Save file as:")
- IF new.name$ <> "" THEN
- file.name$ = new.name$
- strip.folders file.name$,short.name$
- WINDOW 1,short.name$
- save.data file.name$
- setup.menu
- ELSE
- restore.menu
- END IF
- refresh.main.window file.name$
-
- CASE 6: ' print file?
- restore.menu
-
- CASE 7: IF window.open% THEN
- close.main.window success%
- window.open% = NOT success%
- END IF
- IF NOT window.open% THEN
- done% = TRUE%
- ELSE
- restore.menu
- END IF
-
- CASE ELSE:
-
- END SELECT
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' check what data menu item was chosen
- '------------------------------------------------------------------------------
- SUB handle.data.menu (menu.item%) STATIC
-
- IF menu.item% = 1 THEN
- ' show "Preferences" dialog?
- restore.menu
- END IF
-
- ' to demonstrate the use of other cursors:
- changecursor 4 ' 1-4 available
- sleep 2!
- INITCURSOR
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' open window for new file
- '------------------------------------------------------------------------------
- SUB open.main.window (file.name$,do.load%) STATIC
-
- ' for compiler only:
- ' dim rect%(4)
- ' dim outstring$,title$
-
- strip.folders file.name$,title$
- WINDOW 1,title$,,1
- TEXTFONT 0
- winx% = 5
- winy% = 43
-
- IF file.name$ <> "Untitled" AND do.load% THEN
- load.data file.name$
- END IF
-
- setrect rect%(0),10,10,170,30
- outstring$ = "Honest president:"
- textbox outstring$,rect%(0),0
- EDIT FIELD 1,dd.edit1$,(180,10)-(480,25),1
-
- setrect rect%(0),10,50,170,70
- outstring$ = "Whatever:"
- textbox outstring$,rect%(0),0
- EDIT FIELD 2,dd.edit2$,(180,50)-(480,65),1
-
- IF dd.circle.on% THEN
- CIRCLE (200,200),50
- END IF
-
- fat.button 1,1,"Circle",80,256
- BUTTON 2,1,"Erase",(200,260)-(270,280),1
-
- EDIT FIELD selected.field% 'make this the initially active field
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' try to close window
- '------------------------------------------------------------------------------
- SUB close.main.window (success%) STATIC
-
- success% = TRUE%
- IF changes% THEN
- alert.changes success%
- END IF
-
- IF success% THEN
- WINDOW CLOSE 1
- END IF
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' load data from file
- '------------------------------------------------------------------------------
- SUB load.data (file.name$) STATIC
-
- OPEN file.name$ FOR INPUT AS #1
- LINE INPUT #1, dd.edit1$
- LINE INPUT #1, dd.edit2$
- INPUT #1, dd.circle.on%
- CLOSE #1
-
- changes% = FALSE%
- selected.field% = 1
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' save data in file
- '------------------------------------------------------------------------------
- SUB save.data (file.name$) STATIC
-
- dd.edit1$ = EDIT$(1) 'contents of first edit field in window
- dd.edit2$ = EDIT$(2)
-
- OPEN file.name$ FOR OUTPUT AS #1
- PRINT #1, dd.edit1$
- PRINT #1, dd.edit2$
- PRINT #1, dd.circle.on%
- CLOSE #1
-
- changes% = FALSE%
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' Handle window. Note we are ignoring window.number% since we only have one window.
- '------------------------------------------------------------------------------
- SUB handle.window (event.type%,window.number%,file.name$) STATIC
-
- ' for compiler only
- ' dim selected.button%,tentative.field%
-
- SELECT CASE event.type%
- CASE 1: ' button pressed
- selected.button% = DIALOG(1)
- handle.main.button selected.button%
-
- CASE 2: ' new field selected
- tentative.field% = DIALOG(2)
- handle.main.edit.field.change tentative.field%
-
- CASE 4: ' close box pressed
- 'handle.file.menu 3,file.name$,0
- handle.main.close.box file.name$
-
- CASE 6: ' RETURN pressed - carry out fat button
- handle.main.button 1
-
- CASE 7: ' tab key pressed - go to next edit field
- IF selected.field% = 1 THEN
- tentative.field% = 2
- ELSE
- tentative.field% = 1
- END IF
- EDIT FIELD tentative.field%
- handle.main.edit.field.change tentative.field%
-
- CASE ELSE:
-
- END SELECT
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' check button in main window
- '------------------------------------------------------------------------------
- SUB handle.main.button (button.no%) STATIC
-
- SELECT CASE button.no%
- CASE 1: IF NOT dd.circle.on% THEN
- dd.circle.on% = TRUE%
- CIRCLE (200,200),50
- IF NOT changes% THEN
- changes% = TRUE%
- menu.after.changes
- END IF
- END IF
-
- CASE 2: IF dd.circle.on% THEN
- dd.circle.on% = FALSE%
- forecolor 30
- CIRCLE (200,200),50
- forecolor 33
- IF NOT changes% THEN
- changes% = TRUE%
- menu.after.changes
- END IF
- END IF
-
- CASE ELSE:
-
- END SELECT
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' this event means that the user has selected another field
- '------------------------------------------------------------------------------
- SUB handle.main.edit.field.change (active.edit.field.no%) STATIC
-
- ' for compiler only:
- ' dim rect%(4),legal%
- ' dim outstring$
-
- setrect rect%(0),10,90,270,110
-
- SELECT CASE active.edit.field.no%
- CASE 1: outstring$ = "Length is: " + STR$(LEN(EDIT$(selected.field%)))
- textbox outstring$,rect%(0),0
- selected.field% = active.edit.field.no% 'keep track of current field
-
- CASE 2: check.selected.field legal%
- ' you should also probably check this when you "Save" or "Save as..."
- IF NOT legal% THEN
- outstring$ = "Illegal value!" 'or put up a dialog window
- textbox outstring$,rect%(0),0
- EDIT FIELD selected.field% ' return to previous field
- ELSE
- outstring$ = "OK value."
- textbox outstring$,rect%(0),0
- selected.field% = active.edit.field.no%
- END IF
-
- CASE ELSE:
-
- END SELECT
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' see if field has legal value in it.
- '------------------------------------------------------------------------------
- SUB check.selected.field (legal%) STATIC
-
- legal% = TRUE%
-
- IF selected.field% = 1 THEN
- IF EDIT$(1) = "Richard Nixon" THEN
- legal% = FALSE%
- END IF
- ELSEIF selected.field% = 2 THEN
- 'any restrictions on field 2?
- END IF
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' user has clicked close box of window. We must reopen it if they change their mind.
- ' (Unfortunately QB closes the box before we can intercept it.)
- '------------------------------------------------------------------------------
- SUB handle.main.close.box (file.name$) STATIC
-
- ' for compiler only
- ' dim success%
-
- close.main.window success%
- window.open% = NOT success%
- IF NOT window.open% THEN
- file.name$ = ""
- windowless.menu
- ELSE
- open.main.window file.name$,FALSE%
- END IF
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' Handle mouse click. Ignore window.number% since there's only one window.
- '------------------------------------------------------------------------------
- SUB handle.mouse (event.type%,window.number%) STATIC
-
- ' for compiler only
- ' dim mouse.x%,mouse.y%,rect%(4)
- ' dim outstring$
-
- IF event.type% = 1 THEN ' mouse was clicked
- mouse.x% = MOUSE(3) ' x coord when button was first pressed
- mouse.y% = MOUSE(4) ' y coord when button was first pressed
- setrect rect%(0),10,110,200,130
- outstring$ = "x =" + STR$(mouse.x%) + " y =" + STR$(mouse.y%)
- textbox outstring$,rect%(0),0
- ELSEIF event.type% = -1 THEN
- ' call routine to handle mouse still down
- END IF
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' check whether edit field was changed, update data variables
- '------------------------------------------------------------------------------
- SUB check.for.edit.changes STATIC
-
- ' for compiler only:
- ' dim entry1$,entry2$
-
- entry1$ = EDIT$(1)
- entry2$ = EDIT$(2)
-
- IF entry1$ <> dd.edit1$ OR entry2$ <> dd.edit2$ THEN
- dd.edit1$ = entry1$
- dd.edit2$ = entry2$
- IF NOT changes% THEN
- changes% = TRUE%
- menu.after.changes
- END IF
- END IF
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' alert user that changes have occurred
- '------------------------------------------------------------------------------
- SUB alert.changes (continue%) STATIC
-
- ' for compiler only:
- ' dim rect%(4)
- ' dim outstring$
-
- BEEP
-
- ' you need about 1 integer to store a 13 (?) square pixel area;
- ' make sure pic% is big enough!
- GET (45-winx%,45-winy%)-(240-winx%,210-winy%),pic%
-
- WINDOW 2,,(50,50)-(230,200),-2
- TEXTFONT 0
-
- setrect rect%(0),0,0,180,100
- outstring$ = "Changes have been made. Continue without saving?"
- textbox outstring$,rect%(0),0
- BUTTON 1,1,"No",(50,120)-(120,135),1
- BUTTON 2,1,"Yes",(50,100)-(120,115),1
-
- clear.dialog.queue
-
- ' local event loop since this is a modal alert
- WHILE DIALOG(0) <> 1
- WEND
-
- IF DIALOG(1) = 1 THEN
- continue% = FALSE%
- ELSE
- continue% = TRUE%
- END IF
-
- WINDOW CLOSE 2
-
- ' refresh the screen
- PUT (45-winx%,45-winy%)-(240-winx%,210-winy%),pic%,PSET
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' reset queue of dialog events
- '------------------------------------------------------------------------------
- SUB clear.dialog.queue STATIC
-
- WHILE DIALOG(0) <> 0
- WEND
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' draw button with double border
- '------------------------------------------------------------------------------
- SUB fat.button (button.no%,state%,message$,x%,y%) STATIC
-
- ' for compiler only:
- ' dim rect%(4)
-
- setrect rect%(0),x%,y%,x%+76,y%+28
- PENSIZE 3,3
- FRAMEROUNDRECT VARPTR(rect%(0)),16,16
- PENNORMAL
- BUTTON button.no%,state%,message$,(x%+4,y%+4)-(x%+72,y%+24),1
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' remove folder names from file name
- '------------------------------------------------------------------------------
- SUB strip.folders (file.name$,short.name$) STATIC
-
- short.name$ = file.name$
-
- WHILE INSTR(short.name$,":") > 0
- short.name$ = RIGHT$(short.name$,LEN(short.name$)-INSTR(short.name$,":"))
- WEND
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' wait specified number of seconds
- '------------------------------------------------------------------------------
- SUB sleep (sleep.time) STATIC
-
- ' for compiler only:
- ' dim start.time
-
- start.time = TIMER
- WHILE TIMER < start.time + sleep.time
- WEND
-
- END SUB
-
- '------------------------------------------------------------------------------
- ' Redraw main window for use after file selection dialog. It would be preferable
- ' to use GET/PUT as we do for the alert.changes dialog, but I haven't figured out
- ' where the file selection dialog appears, or how big it is.
- '------------------------------------------------------------------------------
- SUB refresh.main.window (file.name$) STATIC
-
- WINDOW CLOSE 1
- open.main.window file.name$,FALSE%
-
- END SUB
-